perm filename PAKMSS.F4[MSS,LCS] blob sn#155845 filedate 1975-04-18 generic text, type T, neo UTF8
00100	C  TO PUT .DAT MSS FILES TOGETHER AND TAKE APART.  LOAD WITH MSFAIL
00200		DIMENSION SV(127)
00300		COMMON V(78),ISCR,LCNT,LIST(200) ,RN(2100)
00400		1 ,RSTFAC(8),NM,STFF(8),ITEM,I,PWDS(250)
00500		EQUIVALENCE (SV,RN)
00600		GO=0
00700		TYPE 1
00800	1	FORMAT(' PACK, UNPACK, ADD TO? -- '$)
00850	C  TYPE 'L' TO ONLY LIST NAMES IN PACKED FILE.
00900		ACCEPT 2,K
01000	2	FORMAT(A1)
01100		IF(K.EQ.'P')GO TO 3
01150		IF(K.EQ.'A')TYPE 527
01200	6	TYPE 20
01300		ACCEPT 21,NAME
01400		NN=1
01420		IF(K.EQ.'L')GO TO 627
01500		IF(K.NE.'A')GO TO 127
01600	227	TYPE 26
01700		ACCEPT 21,NOUT
01800		IF(NAME.EQ.NOUT)GO TO 227
01900		TYPE 327
02000	327	FORMAT(' ADD FILE')
02050	527	FORMAT(' INPUT')
02100		TYPE 20
02200		GO TO 427
02220	627	NZ=' '
02260		GO TO 727
02300	
02400	127	TYPE 27
02500	27	FORMAT(' GET WHICH FILE?  '$)
02600	427	ACCEPT 21,NZ,N
02700	C  BLANK NAME GETS ALL ON FILE.  NAME, NUM. GETS THAT NUM OF FILES.
02800		IF(NZ.EQ.'ALL')NZ=' '
02900		IF(NZ.EQ.' ')N=999
03000	C  BLANK GETS ALL
03100	727	CALL GETFI2(NAME)
03200		IF(K.EQ.'A')GO TO 126
03300	90	CALL FASTI2(RSTFAC,21)
03400		IF(NM.NE.-999)GO TO 91
03500		IF(K.NE.'A')CALL EXIT
03600	C  NOW GO ADD THE FILES
03700		NAME=NZ
03800		K='P'
03900		GO TO 200
04000	91	CALL FASTI2(RN,I)
04100		L=ITEM+1
04200		CALL FASTI2(PWDS,L)
04300		NAME=NM
04400		IF(K.EQ.'A')GO TO 311
04500		IF(NZ.EQ.' ')GO TO 311
04600		IF(NZ.NE.NAME)GO TO 90
04700	C  SEARCH FOR A PARTICULAR NAME.
04800	311	TYPE 10,NAME
04850		IF(K.EQ.'L')GO TO 90
04900		IF(K.EQ.'A')GO TO 131
05000		IF(LOOKD(NAME).GE.0)GO TO 102
05100		IF(GO.EQ.'G')GO TO 104
05200		TYPE 101
05300		ACCEPT 2,GO
05400	C  ANSWER 'G' (FOR GO) TO REPLACE ALL!  BE CAREFUL!!!
05500		IF(GO.NE.'N')GO TO 102
05600	C  IF 'NO' GO BACK FOR NEXT FILE
05700		TYPE 103
05800		ACCEPT 21,NAME
05900		IF(NAME.EQ.' ')GO TO 90
06000		GO TO 102
06100	103	FORMAT(' TYPE NEW NAME -- '$)
06200	105	FORMAT(' REPLACED')
06300	104	TYPE 105
06400	102	REWIND 1
06500		CALL OFILE(1,NAME)
06600	11	ISCR=1
06700		LIST(1)=0
06800	C CLEARS MOTIVE LIST
06900	 	WRITE(1)ITEM,I,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,V(1),
07000		1 ISCR,LIST(1),RSTFAC,STFF,NM,SV
07100		WRITE(1)RSTFAC,STFF,NM,L,L,L
07200	8	END FILE 1
07300		NN=NN+1
07400		NZ=' '
07500		IF(NN.LE.N)GO TO 90
07600		CALL EXIT
07700	
07800	3	TYPE 26
07900	26	FORMAT(' TYPE OUTPUT FILE NAME -- '$)
08000		ACCEPT 21,NOUT
08100	126	IF(LOOKF(NOUT).GE.0)GO TO 100
08150		TYPE 10,NOUT
08200		TYPE 101
08300	101	FORMAT(' WRITE OVER THIS FILE?  '$)
08400		ACCEPT 2,L
08500		IF(L.EQ.'N')GO TO 3
08600	100	CALL PUTFIL(NOUT)
08700		IF(K.EQ.'A')GO TO 90
08800	25	TYPE 20
08900	20	FORMAT(' TYPE FILE NAME --  '$)
09000		ACCEPT  21,NAME,N
09100	C  N IS FOR HOW MANY FILES. 0=999.  IF NAME IS <5 LETTERS MUST USE N.
09200	200	NMZ=NAME
09300		IF(NAME.EQ.' ')GO TO 30
09400		NN=1
09500		IF(N.EQ.0)N=999
09600	C  WILL READ ALL IT CAN FIND.
09700	21	FORMAT(A5,I)
09800	23	IF(LOOKD(NAME))GO TO 221
09900	C  JUMP IF IT FOUND IT.
10000		TYPE 24
10100	24	FORMAT(' FILE NOT FOUND'/)
10200		GO TO 25
10300	
10400	22	IF(LOOKD(NAME).GE.0)GO TO 25
10500	221	NM=NAME
10600	4	REWIND 21
10700		CALL IFILE(21,NAME)
10800	7	NMX=NAME
10900	9	READ(21,END=30)ITEM,I
11000		1,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,(V(L),L=1,ISCR),
11100		1 LCNT,(LIST(L),L=1,LCNT),RSTFAC,STFF,NAME
11200		READ(21,END=31)RSTFAC,STFF
11300	10	FORMAT(1XA5)
11400	31	TYPE 10,NMX
11500		NM=NMX 
11600	131	CALL FASTOU(RSTFAC,21)
11700		CALL FASTOU(RN,I)
11800		ITEM=ITEM+1
11900		CALL FASTOU(PWDS,ITEM)
12000		IF(K.EQ.'A')GO TO 90
12100		IF(NN.GE.N)GO TO 25
12200	
12300	5	NN=NN+1
12400		NAME=NMX
12500		NAME=NAME+2
12600	C  GOES UP THE ALPHABET
12700		IF(LOOKD(NAME))GO TO 221 
12800		NAME=NMZ+256
12900		NMZ=NAME
13000		GO TO 22
13100	30	IF(K.EQ.'U')CALL EXIT
13200		NM=-999
13300		CALL FASTOU(RSTFAC,21)
13400		CALL FINFIL
13500		END